PC Plus SuperCD (UK) 1994 June/PC Plus Super CD coverdisc Issue 93 June 1994.iso/suprdisk/button/frmnew.frm

Visual Basic Form | 1994-04-01 | 7.4 KB | 250 lines

VERSION 2.00
Begin Form frmNew
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "New Button"
   ClientHeight    =   3225
   ClientLeft      =   2025
   ClientTop       =   3105
   ClientWidth     =   4455
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Height          =   3630
   Left            =   1965
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3225
   ScaleWidth      =   4455
   Top             =   2760
   Width           =   4575
   Begin HScrollBar hsrDown
      Height          =   285
      Left            =   3375
      TabIndex        =   5
      Top             =   1350
      Width           =   390
   End
   Begin HScrollBar hsrAcross
      Height          =   285
      Left            =   3375
      TabIndex        =   4
      Top             =   990
      Width           =   390
   End
   Begin TextBox tbxAcross
      Height          =   285
      Left            =   2850
      MaxLength       =   2
      TabIndex        =   0
      Top             =   990
      Width           =   465
   End
   Begin TextBox tbxDown
      Height          =   285
      Left            =   2850
      MaxLength       =   2
      TabIndex        =   1
      Top             =   1350
      Width           =   465
   End
   Begin CommandButton cmdOK
      Caption         =   "OK"
      Height          =   420
      Left            =   975
      TabIndex        =   2
      Top             =   1935
      Width           =   915
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   420
      Left            =   2250
      TabIndex        =   3
      Top             =   1935
      Width           =   915
   End
   Begin Label lblMax
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Maximise the window to increase the maximum sizes"
      Height          =   465
      Left            =   900
      TabIndex        =   12
      Top             =   2520
      Visible         =   0   'False
      Width           =   2415
   End
   Begin Label Label2
      BackStyle       =   0  'Transparent
      Caption         =   "(Minimum = 11 pixels). F1 for Help"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   -1  'True
      ForeColor       =   &H000000C0&
      Height          =   195
      Left            =   750
      TabIndex        =   11
      Top             =   585
      Width           =   2940
   End
   Begin Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Please enter the button dimensions in Pixels"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   -1  'True
      ForeColor       =   &H000000C0&
      Height          =   240
      Left            =   300
      TabIndex        =   10
      Top             =   270
      Width           =   3840
   End
   Begin Label lblMaxHeight
      BackStyle       =   0  'Transparent
      Caption         =   "lblMaxY"
      Height          =   240
      Left            =   2025
      TabIndex        =   9
      Top             =   1395
      Width           =   615
   End
   Begin Label lblMaxAcross
      BackStyle       =   0  'Transparent
      Caption         =   "lblMaxX"
      Height          =   240
      Left            =   2025
      TabIndex        =   8
      Top             =   1035
      Width           =   690
   End
   Begin Label lblAcross
      BackStyle       =   0  'Transparent
      Caption         =   "Across (Max ="
      Height          =   285
      Left            =   750
      TabIndex        =   7
      Top             =   1035
      Width           =   1290
   End
   Begin Label lblDown
      BackStyle       =   0  'Transparent
      Caption         =   "Down  (Max ="
      Height          =   285
      Left            =   750
      TabIndex        =   6
      Top             =   1395
      Width           =   1215
   End
Option Explicit
Dim MaxWidth As Integer
Dim MaxHeight As Integer
Sub cmdCancel_Click ()
    frmNew.Tag = ""
    frmNew.Hide
End Sub
Sub cmdOK_Click ()
    Dim Msg As String
    Dim WhichLabel As Integer
    On Error GoTo TooBig
    If Val(tbxAcross) < 11 Then Error 32765
    If Val(tbxDown) < 11 Then Error 32764
    If tbxAcross > MaxWidth Then Error 32767
    If tbxDown > MaxHeight Then Error 32766
    BitMap.ButtonWidth = Val(frmNew!tbxAcross)
    BitMap.ButtonHeight = Val(frmNew!tbxDown)
    'Start a new master bitmap
    BitMap.Position = 0
    frmBitMap!picBitMap.Cls
    frmNew.Tag = "OK"
    frmNew.Hide
Exit Sub
TooBig:
    Select Case Err
        Case 32767
            Msg = "TOO WIDE! Max width is " & Str$(MaxWidth)
            WhichLabel = 1
        Case 32766
            Msg = "TOO HIGH! Max height is " & Str$(MaxHeight)
            WhichLabel = 2
        Case 32765
            Msg = "That's not a valid entry"
            WhichLabel = 1
        Case 32764
            Msg = "That's not a valid entry"
            WhichLabel = 2
        Case Else
            MsgBox "Unexpected error"
    End Select
    If Err > 32765 And frmButton.WindowState = 0 Then Msg = Msg & CR & "Try maximising the window"
    MsgBox Msg, 0, "Buttons"
    If WhichLabel = 1 Then
        tbxAcross.SetFocus
    Else
        tbxDown.SetFocus
    End If
    Exit Sub
    Resume Next
End Sub
Sub Form_Activate ()
    Dim Subtract As Integer
    Select Case frmButton.WindowState
        Case 0
            lblMax.Visible = True
        Case Else
            lblMax.Visible = False
    End Select
    Subtract = frmButton!picTools.Height + frmButton!lblButton(0).Height + 6
    MaxHeight = (frmButton.ScaleHeight - Subtract) \ 9
    MaxWidth = (frmButton.ScaleWidth \ 9) - 1
    hsrAcross.Min = 11
    hsrDown.Min = 11
    hsrAcross.Max = MaxWidth
    hsrDown.Max = MaxHeight
    lblMaxAcross = Format$(MaxWidth) & ")"
    lblMaxHeight = Format$(MaxHeight) & ")"
    tbxAcross.SetFocus
    HelpItem = 9
End Sub
Sub Form_KeyDown (Keycode As Integer, Shift As Integer)
    If Keycode = &H70 Then Cheap_Help Format$(HelpItem)
End Sub
Sub Form_Load ()
    Position_Form frmNew
    KeyPreview = True
    hsrAcross = 25
    hsrDown = 25
End Sub
'   Select the text in the textbox that has got the focus
'   - Called from the textbox's GotFocus event
Sub Highlight (ctr As TextBox)
    ctr.SelStart = 0
    ctr.SelLength = Len(ctr)
End Sub
Sub hsrAcross_Change ()
    tbxAcross = hsrAcross
End Sub
Sub hsrDown_Change ()
    tbxDown = hsrDown
End Sub
Sub tbxAcross_GotFocus ()
    Highlight tbxAcross
End Sub
Sub tbxAcross_KeyPress (Keyascii As Integer)
    If Keyascii = 13 Then Keyascii = 0: tbxDown.SetFocus
End Sub
Sub tbxDown_GotFocus ()
    Highlight tbxDown
End Sub
Sub tbxDown_KeyPress (Keyascii As Integer)
    If Keyascii = 13 Then Keyascii = 0: cmdOk.SetFocus
End Sub